home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).adf / Examples / Snow.p < prev    next >
Text File  |  1989-07-02  |  4KB  |  188 lines
  1. Program Snowflake;
  2.  
  3. { This program draws a fractal snowflake pattern.  I think I got it out
  4. of some magazine years ago.  It was written, as I remember it, for the
  5. PC in BASIC, which I converted to AmigaBASIC.  I have long since
  6. forgotten the details of how it worked, so I could not give the
  7. variables meaningful names.  To the original author, by the way, goes
  8. the credit for those names.  Invoke the program with the line "Snow
  9. <level>", where <level> is a digit between 1 and 6.  In order to get a
  10. feel for what's going on, try running the levels in order.  Level 6
  11. takes a long time, and frankly doesn't look as good as level 5.  }
  12.  
  13. {$I ":Include/Ports.i" for GetMsg and WaitPort }
  14. {$I ":Include/Intuition.i" for the windows }
  15. {$I ":Include/Mathtrans.i" for sin, cos, and sqrt}
  16. {$I ":Include/Graphics.i" for move() and draw() }
  17. {$I ":Include/Exec.i" just for OpenLibrary and CloseLibrary }
  18.  
  19. var
  20.     dx : array [0..11] of real;
  21.     dy : array [0..11] of real;
  22.     sd : array [0..6] of integer;
  23.     rd : array [0..6] of integer;
  24.     sn : array [0..6] of integer;
  25.     ln : array [0..6] of real;
  26.     a  : real;
  27.     nc : integer;
  28.     x, y, t : real;
  29.     w  : WindowPtr;
  30.     rp : RastPortPtr;
  31.     n  : integer;
  32.     d, ns, i, j : integer;
  33.     l : real;
  34.     m : MessagePtr;
  35.  
  36. Procedure usage;
  37. begin
  38.     writeln('Usage: Snow <level>');
  39.     writeln('       where <level> is between 1 and 6');
  40.     exit(20);
  41. end;
  42.  
  43. Function readcycles(): integer;
  44. var
  45.     index : integer;
  46.     cycles : integer;
  47. begin
  48.     index := 0;
  49.     while ((commandline[index] = ' ') or (commandline[index] = chr(9))) and
  50.     (index < 128) do
  51.     index := index + 1;
  52.     if index >= 128 then
  53.     usage;
  54.     cycles := ord(commandline[index]) - ord('0');
  55.     if (cycles > 6) or (cycles < 1) then
  56.     usage;
  57.     readcycles := cycles;
  58. end;
  59.  
  60. Function OpenTheWindow() : Boolean;
  61. var
  62.     nw : NewWindowPtr;
  63. begin
  64.     new(nw);
  65.  
  66.     nw^.LeftEdge := 0;
  67.     nw^.TopEdge := 0;
  68.     nw^.Width := 640;
  69.     nw^.Height := 200;
  70.  
  71.     nw^.DetailPen := -1;
  72.     nw^.BlockPen  := -1;
  73.     nw^.IDCMPFlags := CLOSEWINDOW_f;
  74.     nw^.Flags := WINDOWDEPTH_f + WINDOWCLOSE_f + SMART_REFRESH_f + ACTIVATE_f;
  75.     nw^.FirstGadget := nil;
  76.     nw^.CheckMark := nil;
  77.     nw^.Title := "Fractal Snowflake";
  78.     nw^.Screen := nil;
  79.     nw^.BitMap := nil;
  80.     nw^.MinWidth := 50;
  81.     nw^.MaxWidth := -1;
  82.     nw^.MinHeight := 20;
  83.     nw^.MaxHeight := -1;
  84.     nw^.WType := WBENCHSCREEN_f;
  85.  
  86.     w := OpenWindow(nw);
  87.     dispose(nw);
  88.     OpenTheWindow := w <> nil;
  89. end;
  90.  
  91. procedure initarrays;
  92. begin
  93.     sd[0] := 0;
  94.     rd[0] := 0;
  95.     sd[1] := 1;
  96.     rd[1] := 0;
  97.     sd[2] := 1;
  98.     rd[2] := 7;
  99.     sd[3] := 0;
  100.     rd[3] := 10;
  101.     sd[4] := 0;
  102.     rd[4] := 0;
  103.     sd[5] := 0;
  104.     rd[5] := 2;
  105.     sd[6] := 1;
  106.     rd[6] := 2;
  107.  
  108.     for n := 0 to 6 do
  109.     ln[n] := 1.0 / 3.0;
  110.     ln[2] := spsqrt(ln[1]);
  111.     a := 0.0;
  112.     for n := 6 to 11 do begin
  113.     dy[n] := spsincos(dx[n], a);
  114.         a := a + 0.52359;
  115.     end;
  116.     for n := 0 to 5 do begin
  117.     dx[n] := -(dx[n + 6]);
  118.     dy[n] := -(dy[n + 6]);
  119.     end;
  120.     x := 534.0;
  121.     y := 151.0;
  122.     t := 324.0;
  123. end;
  124.  
  125. begin
  126.     nc := readcycles();
  127.     if not OpenMathTrans() then begin
  128.     writeln('Could not open MathTrans.library.');
  129.     exit(20);
  130.     end;
  131.     initarrays;
  132.  
  133.     GfxBase := OpenLibrary("graphics.library", 0);
  134.     if GfxBase = nil then begin
  135.     writeln('Could not open Graphics.library');
  136.     FlushMathTrans;
  137.     exit(20);
  138.     end;
  139.  
  140.     if OpenTheWindow() then begin
  141.     rp := w^.RPort;
  142.  
  143.     for n := 0 to nc do
  144.         sn[n] := 0;
  145.  
  146.     Move(rp, trunc(x), trunc(y));
  147.  
  148.     repeat
  149.         d := 0;
  150.         l := t;
  151.         ns := 0;
  152.  
  153.         for n := 1 to nc do begin
  154.         i := sn[n];
  155.         l := l * ln[i];
  156.         j := sn[n - 1];
  157.         ns := ns + sd[j];
  158.         if odd(ns) then
  159.             d := (d + 12 - rd[i]) mod 12
  160.         else
  161.             d := (d + rd[i]) mod 12;
  162.         end;
  163.  
  164.         x := x + 1.33 * l * dx[d];
  165.         y := y - 0.5 * l * dy[d];
  166.  
  167.         Draw(rp, trunc(x), trunc(y));
  168.         sn[nc] := sn[nc] + 1;
  169.         n := nc;
  170.         while (n >= 1) and (sn[n] = 7) do begin
  171.         sn[n] := 0;
  172.         sn[n - 1] := sn[n - 1] + 1;
  173.         n := n - 1;
  174.         end;
  175.     until sn[0] <> 0;
  176.     m := WaitPort(w^.UserPort);
  177.     forbid;
  178.     repeat
  179.         m := GetMsg(w^.UserPort);
  180.     until m = nil;
  181.     permit;
  182.     CloseWindow(w);
  183.     end else
  184.     writeln('Could not open the window');
  185.     CloseLibrary(GfxBase);
  186.     FlushMathTrans;
  187. end.
  188.